perm filename PLTSRT.LST[1,MUS] blob sn#066150 filedate 1973-10-06 generic text, type T, neo UTF8
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 1


				00010	C  SUBRS. ALPHA, RHORZ, SLUR, JUGGLE, LOOP, PLTSRT, LINES, RDRAW

				00020	

				00100	C****** FOR LISTS OF LETTERS, ETC. *******


				00200	      SUBROUTINE ALPHA
1M    	BLOCK	0

				00300	      COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)

				00600	      EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
				00700	     1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
				00800	     1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))

				00900	      COMMON/STF/RSTFAC(8),RSTJC

				01000	

				01100	      IF(JA.EQ.20)GO TO 20
      	MOVEI 	02,24
      	CAMN  	02,JA    
      	JRST  	20P   

				01200	CC	RSTJC=RSTFAC(JC+4)

				01300	      JA=5
      	MOVEI 	02,5
      	MOVEM 	02,JA    

				01400	54    R=19.7*RJE*RSTJC
54P   	MOVE  	02,CONST.
      	FMPR  	02,RJE   
      	FMPR  	02,RSTJC 
      	MOVEM 	02,R     

				01500	      J=R
      	JSA   	16,IFIX  
      	ARG   	00,R     
      	MOVEM 	00,J     

				01600	      RND=R-J
      	JSA   	16,FLOAT 
      	ARG   	00,J     
      	FSBR  	00,R     
      	MOVNM 	00,RND   

				01700	      R=0
      	SETZM 	R     
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 2



				01800	      DO 50 KA=4,6
      	MOVEI 	15,4
2M    	MOVEM 	15,KA    
3M    	BLOCK	0

				01900	      JY=RJQ(KA)*100.+.2
      	MOVSI 	02,207620
      	FMPR  	02,RJQ   -1(15)
      	FADR  	02,CONST.+1
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,JY    

				02000	      JX=1000000
      	MOVE  	02,CONST.+2
      	MOVEM 	02,JX    

				02100	      DO 53 LA=1,4
      	MOVEI 	15,1
4M    	MOVEM 	15,LA    
5M    	BLOCK	0

				02200	      JF=JY/JX
      	MOVE  	02,JY    
      	IDIV  	02,JX    
      	MOVEM 	02,JF    

				02300	CC	IF(JF.LT.90)CALL NOTWRT

				02350	      IF(JF.NE.47.AND.JF.LT.90)CALL NOTWRT
      	MOVEI 	02,132
      	CAMG  	02,JF    
      	TDZA  	02,2
      	SETO  	02,0
      	MOVEI 	03,57
      	CAMN  	03,JF    
      	TDZA  	03,3
      	SETO  	03,0
      	AND   	02,3
      	JUMPGE	02,6M    
      	JSA   	16,NOTWRT
6M    	BLOCK	0

				02400	C  47=BLANK  (WAS 99)

				02500	      JY=JY-JF*JX
      	MOVE  	02,JX    
      	IMUL  	02,JF    
      	SUBM  	02,JY    
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 3


      	MOVNS 	00,JY    

				02600	      JB=JB+J
      	MOVE  	02,J     
      	ADDM  	02,JB    

				02700	      R=R+RND
      	MOVE  	02,RND   
      	FADRM 	02,R     

				02800	      IF(R.LT.1.0)GO TO 53
      	MOVSI 	02,201400
      	CAMLE 	02,R     
      	JRST  	53P   

				02900	      JB=JB+1
      	AOS   	JB    

				03000	      R=R-1.0
      	MOVN  	02,CONST.+3
      	FADRM 	02,R     

				03100	53    JX=JX/100
53P   	MOVE  	02,JX    
      	IDIVI 	02,144
      	MOVEM 	02,JX    
      	CAIGE 	15,4
      	AOJA  	15,4M    

				03200	50    CONTINUE
50P   	MOVE  	15,KA    
      	CAIGE 	15,6
      	AOJA  	15,2M    

				03240	      RETURN
      	JRST  	7M    

				03400	C  FOR TRILLS

				03500	20    R=RJB
20P   	MOVE  	02,RJB   
      	MOVEM 	02,R     

				03600	C  R SAVES RJB(WHICH GETS CLOBBERED WHEN 'TR' IS WRITTEN.)

				03750	C 20, POS1, STF, NT#, 0, POS2, X     IF X=1 THEN NO WAVEY LINE

				03800	      RJE=.65
      	MOVE  	02,CONST.+4
      	MOVEM 	02,RJE   
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 4



				03850	      JE=0
      	SETZM 	JE    

				03900	      JA=5
      	MOVEI 	02,5
      	MOVEM 	02,JA    

				04000	      JF=29
      	MOVEI 	02,35
      	MOVEM 	02,JF    

				04100	C   DRAWS T

				04200	      CALL NOTWRT
      	JSA   	16,NOTWRT

				04300	      JF=27
      	MOVEI 	02,33
      	MOVEM 	02,JF    

				04400	C   DRAWS R

				04500	      JB=JB+11*RSTJC
      	MOVSI 	02,204540
      	FMPR  	02,RSTJC 
      	JSA   	16,FLOAT 
      	ARG   	00,JB    
      	FADR  	00,2
      	MOVEM 	00,%TEMP.
      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.
      	MOVEM 	00,JB    

				04600	51    CALL NOTWRT
51P   	JSA   	16,NOTWRT

				04750	      IF(JG.NE.0)RETURN
      	MOVE  	02,JG    
      	JUMPE 	02,8M    
      	JRST  	7M    
8M    	BLOCK	0

				04800	      JB=JB+16*RSTJC
      	MOVE  	02,RSTJC 
      	FSC   	02,4
      	JSA   	16,FLOAT 
      	ARG   	00,JB    
      	FADR  	00,2
      	MOVEM 	00,%TEMP.
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 5


      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.
      	MOVEM 	00,JB    

				05000	C   RETURN IF NO WAVY LINE IS NEEDED

				05100	      JA=4
      	MOVEI 	02,4
      	MOVEM 	02,JA    

				05200	      RJB=R+4.*RSTJC
      	MOVE  	02,RSTJC 
      	FSC   	02,2
      	FADR  	02,R     
      	MOVEM 	02,RJB   

				05300	      JG=-2
      	MOVNI 	02,2
      	MOVEM 	02,JG    

				05400	C  JG IS SWITCH TO DRAW WIGGLE

				05500	      RJE=RJD+.8*RSTJC
      	MOVE  	02,CONST.+5
      	FMPR  	02,RSTJC 
      	FADR  	02,RJD   
      	MOVEM 	02,RJE   

				05600	      CALL ITMSUB
      	JSA   	16,ITMSUB

				05800	      END

      	JRST  	7M    
ALPHA%	ARG   	00,0
      	MOVEM 	15,TEMP. 
      	MOVEM 	16,TEMP. +1
      	JRST  	1M    
7M    	MOVE  	15,TEMP. 
      	MOVE  	16,TEMP. +1
      	JRA   	16,0(16)


CONSTANTS

0	205473146314	1	176631463146	2	000003641100	3	201400000000	4	200514631463
5	200631463146	

COMMON

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 6


RJB   	/.COMM./+0	JA    	/.COMM./+1	CENTR 	/.COMM./+2	JB    	/.COMM./+3	RJQ   	/.COMM./+4
JQ    	/.COMM./+30	RSTFAC	/STF   /+0	RSTJC 	/STF   /+10	JC    	/.COMM./+30	JD    	/.COMM./+31
JE    	/.COMM./+32	RJE   	/.COMM./+6	RJF   	/.COMM./+7	JG    	/.COMM./+34	JH    	/.COMM./+35
JI    	/.COMM./+36	JJ    	/.COMM./+37	JK    	/.COMM./+40	JF    	/.COMM./+33	RJG   	/.COMM./+10
RJD   	/.COMM./+5	

SUBPROGRAMS

IFIX  	FLOAT 	NOTWRT	ITMSUB	

SCALARS

ALPHA 	203		JA    	1		R     	204		RJE   	6		RSTJC 	10	
J     	205		RND   	206		KA    	207		JY    	210		JX    	211	
LA    	212		JF    	33		JB    	3		RJB   	0		JE    	32	
JG    	34		RJD   	5		CENTR 	2		JC    	30		JD    	31	
RJF   	7		JH    	35		JI    	36		JJ    	37		JK    	40	
RJG   	10		

ARRAYS

RJQ   	4		JQ    	30		RSTFAC	0		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 7


				05900	


				06000	      FUNCTION RHORZ(R)
1M    	BLOCK	0

				06100	      RHORZ=R*5.96-596.
      	MOVE  	02,CONST.
      	FMPR  	02,R     
      	FSBRI 	02,212452
      	MOVEM 	02,RHORZ 

				06200	      END

      	JRST  	2M    
RHORZ%	ARG   	00,0
      	MOVEM 	02,TEMP. 
      	MOVEM 	15,TEMP. +1
      	MOVEM 	16,TEMP. +2
      	MOVEI 	00,TEMP. +3
      	PUSH  	00,@0(16)
      	JRST  	1M    
2M    	MOVE  	02,TEMP. 
      	MOVE  	15,TEMP. +1
      	MOVE  	16,TEMP. +2
      	MOVE  	00,RHORZ 
      	JRA   	16,1(16)


CONSTANTS

0	203575341217	

GLOBAL DUMMIES

R     	26		

SCALARS

RHORZ 	27		R     	26		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 8


				06300	

				06400	


				06500	      SUBROUTINE SLUR
1M    	BLOCK	0

				06600	      IMPLICIT INTEGER(A-Q,T-Z)

				06700	      REAL CENTR,PWDS

				06710	      COMMON /XRN/RN(4000) /PLTR/PLT,RHT,DIS

				06900	      COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)

				07000	      COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(8),RSTJC

				07200	      EQUIVALENCE (RJG,RJQ(5)),(RJF,RJQ(4)),(JG,JQ(5)),
				07300	     1(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
				07400	     1,(JF,JQ(4)),(RJD,RJQ(2)),(RJE,RJQ(3)),(RF,RJQ(20))

				07500	      DIMENSION SLURX(53),SLURY(53),RSEQ(26)

				07600	      DATA RSEQ/70.0,64.0,59.0,53.9,49.0,44.1,40.0,35.8,32.0,28.2,
				07700	     1 25.0,21.8,19.0,16.3,14.0,11.9,10.0,8.4,6.8,5.3
				07800	     1 ,4.0,2.9,2.0,1.4,1.0,.07/

				07805	      IF(JA.NE.12)GO TO 2
      	MOVEI 	02,14
      	CAME  	02,JA    
      	JRST  	2P    

				07810	      RA=5.96*RSTJC*RJE
      	MOVE  	02,CONST.
      	FMPR  	02,RSTJC 
      	FMPR  	02,RJE   
      	MOVEM 	02,RA    

				07815	      L=3
      	MOVEI 	02,3
      	MOVEM 	02,L     

				07820	      IF(JG.LE.JF)JG=JG+360
      	MOVE  	02,JG    
      	CAMLE 	02,JF    
      	JRST  	2M    
      	MOVEI 	02,550
      	ADDM  	02,JG    
2M    	BLOCK	0
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 9



				07822	      JH=6
      	MOVEI 	02,6
      	MOVEM 	02,JH    

				07823	      IF(PLT)JH=1
      	MOVE  	02,PLT   
      	JUMPGE	02,3M    
      	MOVEI 	02,1
      	MOVEM 	02,JH    
3M    	BLOCK	0

				07825	      DO 3 K=JF,JG,JH
      	MOVE  	15,JF    
4M    	MOVEM 	15,K     
5M    	BLOCK	0

				07830	      R=K
      	JSA   	16,FLOAT 
      	ARG   	00,15
      	MOVEM 	00,R     

				07835	      CALL LINES(RJB+RA*SIND(R),CENTR+RA*COSD(R),L)
      	JSA   	16,SIND  
      	ARG   	02,R     
      	FMPR  	00,RA    
      	FADR  	00,RJB   
      	MOVEM 	00,%TEMP.
      	JSA   	16,COSD  
      	ARG   	02,R     
      	FMPR  	00,RA    
      	FADR  	00,CENTR 
      	MOVEM 	00,%TEMP.+1
      	JSA   	16,LINES 
      	ARG   	02,%TEMP.
      	ARG   	02,%TEMP.+1
      	ARG   	00,L     

				07840	3     L=2
3P    	MOVEI 	02,2
      	MOVEM 	02,L     
      	ADD   	15,JH    
      	MOVE  	03,JG    
      	SUBM  	15,3
      	SKIPGE	00,JH    
      	MOVN  	03,3
      	JUMPLE	03,4M    

				07845	C  JA=12  DRAWS CIRCLES.  P5=RADIUS, P6=DEGR.1, P7=DEGR.2

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 10


				07850	      RETURN
      	JRST  	6M    

				07900	2     JJ=1
2P    	MOVEI 	02,1
      	MOVEM 	02,JJ    

				07910	      TWICE=-1
      	SETOM 	TWICE 

				07920	      IF(PLT)TWICE=0
      	MOVE  	02,PLT   
      	JUMPGE	02,7M    
      	SETZM 	TWICE 
7M    	BLOCK	0

				07930	      RST7=RSTJC*7.
      	MOVSI 	02,203700
      	FMPR  	02,RSTJC 
      	MOVEM 	02,RST7  

				08250	4     RXX=RHORZ(RJF)-RJB
4P    	JSA   	16,RHORZ 
      	ARG   	02,RJF   
      	FSBR  	00,RJB   
      	MOVEM 	00,RXX   

				08260	      RTILT=(RJE-RJD)*RST7
      	MOVE  	02,RJE   
      	FSBR  	02,RJD   
      	FMPR  	02,RST7  
      	MOVEM 	02,RTILT 

				08270	80    RX=SQRT(RXX**2+RTILT**2)
80P   	MOVE  	02,RXX   
      	FMPR  	02,2
      	MOVE  	03,RTILT 
      	FMPR  	03,3
      	FADR  	02,3
      	MOVEM 	02,%TEMP.
      	JSA   	16,SQRT  
      	ARG   	02,%TEMP.
      	MOVEM 	00,RX    

				08280	1     R=CENTR
1P    	MOVE  	02,CENTR 
      	MOVEM 	02,R     

				08300	      IF(JH.NE.0)GO TO 180
      	MOVE  	02,JH    
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 11


      	JUMPN 	02,180P  

				08400	C  FOR BRACKETS

				08410	      RB=RX/52.
      	MOVE  	02,RX    
      	FDVR  	02,CONST.+1
      	MOVEM 	02,RB    

				08500	      DO 81 K=1,53
      	MOVEI 	15,1
8M    	MOVEM 	15,K     
9M    	BLOCK	0

				08600	81    SLURX(K)=RB*(K-1)+RJB
81P   	MOVNI 	02,1
      	ADD   	02,15
      	JSA   	16,FLOAT 
      	ARG   	00,2
      	FMPR  	00,RB    
      	FADR  	00,RJB   
      	MOVEM 	00,SLURX -1(15)
      	CAIGE 	15,65
      	AOJA  	15,9M    

				08700	      RA=-RJG*RST7
      	MOVE  	02,RST7  
      	FMPR  	02,RJG   
      	MOVNM 	02,RA    

				08800	      R=R-RA
      	MOVN  	02,RA    
      	FADRM 	02,R     

				08900	      RW=630.
      	MOVSI 	02,212473
      	MOVEM 	02,RW    

				09010	      RB=RA/RW
      	MOVE  	02,RA    
      	FDVR  	02,RW    
      	MOVEM 	02,RB    

				09100	      DO 82 K=1,26
      	MOVEI 	15,1
10M   	MOVEM 	15,K     
11M   	BLOCK	0

				09200	      SLURY(K)=RW*RB+R
      	MOVE  	02,RB    
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 12


      	FMPR  	02,RW    
      	FADR  	02,R     
      	MOVEM 	02,SLURY -1(15)

				09300	      SLURY(54-K)=SLURY(K)
      	MOVN  	02,15
      	MOVE  	03,SLURY -1(15)
      	MOVN  	04,15
      	MOVEM 	03,SLURY +65(4)

				09400	82    RW=RW-RSEQ(K)
82P   	MOVN  	02,RSEQ  -1(15)
      	FADRM 	02,RW    
      	CAIGE 	15,32
      	AOJA  	15,11M   

				09500	      SLURY(27)=SLURY(26)
      	MOVE  	02,SLURY +31
      	MOVEM 	02,SLURY +32

				09600	      L=53
      	MOVEI 	02,65
      	MOVEM 	02,L     

				09700	

				09800	89    IF(RTILT.EQ.0)GO TO 87
89P   	MOVE  	02,RTILT 
      	JUMPE 	02,87P   

				09900	CC	R=RTILT*RF

				10000	      RW=ATAN2(RTILT,RXX)
      	JSA   	16,ATAN2 
      	ARG   	02,RTILT 
      	ARG   	02,RXX   
      	MOVEM 	00,RW    

				10100	      RA=SIN(RW)
      	JSA   	16,SIN   
      	ARG   	02,RW    
      	MOVEM 	00,RA    

				10200	      RB=COS(RW)
      	JSA   	16,COS   
      	ARG   	02,RW    
      	MOVEM 	00,RB    

				10300	      RZ=SLURX(1)
      	MOVE  	02,SLURX 
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 13


      	MOVEM 	02,RZ    

				10400	      RW=SLURY(1)
      	MOVE  	02,SLURY 
      	MOVEM 	02,RW    

				10500	      DO 84 K=1,L
      	MOVEI 	15,1
12M   	MOVEM 	15,K     
13M   	BLOCK	0

				10600	      SLURX(K)=SLURX(K)-RZ
      	MOVN  	02,RZ    
      	FADRM 	02,SLURX -1(15)

				10700	84    SLURY(K)=SLURY(K)-RW
84P   	MOVN  	02,RW    
      	FADRM 	02,SLURY -1(15)
      	CAMGE 	15,L     
      	AOJA  	15,13M   

				10800	      DO 83 K=1,L
      	MOVEI 	15,1
14M   	MOVEM 	15,K     
15M   	BLOCK	0

				10900	      R=SLURX(K)
      	MOVE  	02,SLURX -1(15)
      	MOVEM 	02,R     

				11000	      SLURX(K)=RB*R-RA*SLURY(K)+RZ
      	MOVE  	02,R     
      	FMPR  	02,RB    
      	FADR  	02,RZ    
      	MOVE  	03,RA    
      	FMPR  	03,SLURY -1(15)
      	FSBR  	02,3
      	MOVEM 	02,SLURX -1(15)

				11100	83    SLURY(K)=RB*SLURY(K)+RA*R+RW
83P   	MOVE  	02,RB    
      	FMPR  	02,SLURY -1(15)
      	FADR  	02,RW    
      	MOVE  	03,RA    
      	FMPR  	03,R     
      	FADR  	02,3
      	MOVEM 	02,SLURY -1(15)
      	CAMGE 	15,L     
      	AOJA  	15,15M   

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 14


				11200	

				11300	87    CALL LINES(SLURX(JJ),SLURY(JJ),3)
87P   	MOVE  	03,JJ    
      	MOVEI 	02,SLURX -1(3)
      	HRRM  	02,16M   
      	MOVEI 	02,SLURY -1(3)
      	HRRM  	02,17M   
      	JSA   	16,LINES 
16M   	ARG   	02,16M   
17M   	ARG   	02,17M   
      	ARG   	00,CONST.+2

				11400	      DO 88 K=JJ+1,L
      	MOVEI 	02,1
      	ADD   	02,JJ    
      	MOVE  	15,2
18M   	MOVEM 	15,K     
19M   	BLOCK	0

				11500	88    CALL LINES(SLURX(K),SLURY(K),2)
88P   	MOVEI 	02,SLURX -1(15)
      	HRRM  	02,20M   
      	MOVEI 	02,SLURY -1(15)
      	HRRM  	02,21M   
      	JSA   	16,LINES 
20M   	ARG   	02,20M   
21M   	ARG   	02,21M   
      	ARG   	00,CONST.+3
      	CAMGE 	15,L     
      	AOJA  	15,18M   

				11510	      IF(TWICE)RETURN
      	MOVE  	02,TWICE 
      	JUMPGE	02,22M   
      	JRST  	6M    
22M   	BLOCK	0

				11520	      TWICE=-1
      	SETOM 	TWICE 

				11530	      RJG=RJG+.1
      	MOVE  	02,CONST.+4
      	FADRM 	02,RJG   

				11540	      GO TO 1
      	JRST  	1P    

				11600	      RETURN
      	JRST  	6M    
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 15



				11700	180   RW=R+RJG*RST7
180P  	MOVE  	02,RST7  
      	FMPR  	02,RJG   
      	FADR  	02,R     
      	MOVEM 	02,RW    

				11800	      RX=RX+RJB
      	MOVE  	02,RJB   
      	FADRM 	02,RX    

				11900	      RA=(RJE-RJD)*RST7
      	MOVE  	02,RJE   
      	FSBR  	02,RJD   
      	FMPR  	02,RST7  
      	MOVEM 	02,RA    

				12000	      SLURX(1)=RJB
      	MOVE  	02,RJB   
      	MOVEM 	02,SLURX 

				12100	      SLURY(1)=R
      	MOVE  	02,R     
      	MOVEM 	02,SLURY 

				12200	      SLURX(2)=RJB
      	MOVE  	02,RJB   
      	MOVEM 	02,SLURX +1

				12300	      SLURY(2)=RW
      	MOVE  	02,RW    
      	MOVEM 	02,SLURY +1

				12400	      SLURX(3)=RX
      	MOVE  	02,RX    
      	MOVEM 	02,SLURX +2

				12500	      SLURY(3)=RW+RA
      	MOVE  	02,RA    
      	FADR  	02,RW    
      	MOVEM 	02,SLURY +2

				12600	      SLURX(4)=RX
      	MOVE  	02,RX    
      	MOVEM 	02,SLURX +3

				12700	      SLURY(4)=R+RA
      	MOVE  	02,RA    
      	FADR  	02,R     
      	MOVEM 	02,SLURY +3
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 16



				12800	      L=4
      	MOVEI 	02,4
      	MOVEM 	02,L     

				12900	      IF(JH.EQ.2)L=3
      	MOVEI 	02,2
      	CAME  	02,JH    
      	JRST  	23M   
      	MOVEI 	02,3
      	MOVEM 	02,L     
23M   	BLOCK	0

				13000	      IF(JH.EQ.3)JJ=2
      	MOVEI 	02,3
      	CAME  	02,JH    
      	JRST  	24M   
      	MOVEI 	02,2
      	MOVEM 	02,JJ    
24M   	BLOCK	0

				13010	      TWICE=-1
      	SETOM 	TWICE 

				13100	      GO TO 87
      	JRST  	87P   

				13200	      END

      	JRST  	6M    
SLUR% 	ARG   	00,0
      	MOVEM 	15,TEMP. 
      	MOVEM 	16,TEMP. +1
      	JRST  	1M    
6M    	MOVE  	15,TEMP. 
      	MOVE  	16,TEMP. +1
      	JRA   	16,0(16)


CONSTANTS

0	203575341217	1	206640000000	2	000000000003	3	000000000002	4	175631463146

COMMON

RN    	/XRN   /+0	PLT   	/PLTR  /+0	RHT   	/PLTR  /+1	DIS   	/PLTR  /+2	RJB   	/.COMM./+0
JA    	/.COMM./+1	CENTR 	/.COMM./+2	JB    	/.COMM./+3	RJQ   	/.COMM./+4	JQ    	/.COMM./+30
PWDS  	/PTR   /+0	ITEM  	/PTR   /+372	L     	/PTR   /+373	I     	/PTR   /+374	IX    	/PTR   /+375
RSTFAC	/STF   /+0	RSTJC 	/STF   /+10	RJG   	/.COMM./+10	RJF   	/.COMM./+7	JG    	/.COMM./+34
JH    	/.COMM./+35	JI    	/.COMM./+36	JJ    	/.COMM./+37	JF    	/.COMM./+33	RJD   	/.COMM./+5
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 17


RJE   	/.COMM./+6	RF    	/.COMM./+27	

SUBPROGRAMS

FLOAT 	LINES 	SIND  	COSD  	RHORZ 	SQRT  	ATAN2 	SIN   	COS   	

SCALARS

SLUR  	377		JA    	1		RA    	400		RSTJC 	10		RJE   	6	
L     	373		JG    	34		JF    	33		JH    	35		PLT   	0	
K     	401		R     	402		RJB   	0		CENTR 	2		JJ    	37	
TWICE 	403		RST7  	404		RXX   	405		RJF   	7		RTILT 	406	
RJD   	5		RX    	407		RB    	410		RJG   	10		RW    	411	
RZ    	412		RHT   	1		DIS   	2		JB    	3		ITEM  	372	
I     	374		IX    	375		JI    	36		RF    	27		

ARRAYS

RN    	0		RJQ   	4		JQ    	30		PWDS  	0		RSTFAC	0	
SLURX 	413		SLURY 	500		RSEQ  	565		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 18


				13300	C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8

				13400	C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY

				13500	

				13600	

				13700	C********  JUGGLER  ********


				13800	      SUBROUTINE JUGGLE
1M    	BLOCK	0

				13900	      IMPLICIT INTEGER(A-Z)

				14000	      REAL DIS,RJB,PWDS,DISX,RN,RJC,RJB,RJQ,RJJ,RJF,RHT,A,B

				14100	      COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)

				14300	      COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO

				14600	

				14700	      ITEM=ITEM-1
      	SOS   	ITEM  

				14800	      JX=RN(MEDIT)+3
      	MOVSI 	02,202600
      	MOVE  	03,MEDIT 
      	FADR  	02,RN    -1(3)
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,JX    

				14900	C  WD CNT OF OLD ITEM

				15000	C  I-IX IS WD CNT OF NEW ITEM

				15100	      JY=IX
      	MOVE  	02,IX    
      	MOVEM 	02,JY    

				15200	      Z=I-IX-JX
      	MOVN  	02,JX    
      	SUB   	02,IX    
      	ADD   	02,I     
      	MOVEM 	02,Z     

				15300	C  SPACE CHANGE
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 19



				15400	      IF(Z)2751,172,751
      	MOVE  	02,Z     

				15500	751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
      	JUMPL 	02,2751P 
      	JUMPE 	02,172P  
751P  	MOVNI 	02,1
      	ADD   	02,I     
      	MOVEM 	02,%TEMP.
      	MOVE  	03,JX    
      	ADD   	03,MEDIT 
      	MOVEM 	03,%TEMP.+1
      	MOVNI 	04,1
      	MOVEM 	04,%TEMP.+2
      	JSA   	16,LOOP  
      	ARG   	00,%TEMP.
      	ARG   	00,%TEMP.+1
      	ARG   	00,%TEMP.+2
      	ARG   	00,Z     
      	ARG   	00,CONST.
      	ARG   	02,RN    

				15600	      JY=IX+Z
      	MOVE  	02,IX    
      	ADD   	02,Z     
      	MOVEM 	02,JY    

				15700	      GO TO 172
      	JRST  	172P  

				15800	

				15900	2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
2751P 	MOVE  	02,JX    
      	ADD   	02,MEDIT 
      	ADD   	02,Z     
      	MOVEM 	02,%TEMP.
      	MOVNI 	03,1
      	ADD   	03,IX    
      	ADD   	03,Z     
      	MOVEM 	03,%TEMP.+1
      	MOVN  	04,Z     
      	MOVEM 	04,%TEMP.+2
      	JSA   	16,LOOP  
      	ARG   	00,%TEMP.
      	ARG   	00,%TEMP.+1
      	ARG   	00,CONST.+1
      	ARG   	00,CONST.
      	ARG   	00,%TEMP.+2
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 20


      	ARG   	02,RN    

				16000	

				16100	172   J=RN(JY)+2
172P  	MOVSI 	02,202400
      	MOVE  	03,JY    
      	FADR  	02,RN    -1(3)
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,J     

				16200	      CALL LOOP(0,J,1,MEDIT,JY,RN)
      	JSA   	16,LOOP  
      	ARG   	00,CONST.
      	ARG   	00,J     
      	ARG   	00,CONST.+1
      	ARG   	00,MEDIT 
      	ARG   	00,JY    
      	ARG   	02,RN    

				16300	      I=IX+Z
      	MOVE  	02,IX    
      	ADD   	02,Z     
      	MOVEM 	02,I     

				16400	

				16500	1751  X=ITEM+1
1751P 	MOVEI 	02,1
      	ADD   	02,ITEM  
      	MOVEM 	02,X     

				16600	      JX=WDS(X22+1)-WDS(X22)
      	MOVE  	03,X22   
      	MOVE  	02,WDS   (3)
      	SUB   	02,WDS   -1(3)
      	MOVEM 	02,JX    

				16700	      J=WDS(X+1)-WDS(X)
      	MOVE  	03,X     
      	MOVE  	02,WDS   (3)
      	SUB   	02,WDS   -1(3)
      	MOVEM 	02,J     

				16800	      Y=J-JX
      	MOVN  	02,JX    
      	ADD   	02,J     
      	MOVEM 	02,Y     

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 21


				16900	      JX=WDS(X)+Y+1
      	MOVEI 	02,1
      	ADD   	02,Y     
      	MOVE  	03,X     
      	ADD   	02,WDS   -1(3)
      	MOVEM 	02,JX    

				17000	      IF(Y)2851,182,282
      	MOVE  	02,Y     

				17100	282   CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
      	JUMPL 	02,2851P 
      	JUMPE 	02,182P  
282P  	MOVEI 	02,2
      	MOVE  	03,X     
      	ADD   	02,WDS   (3)
      	MOVEM 	02,%TEMP.
      	MOVE  	04,X22   
      	MOVEI 	03,WDS   -1(4)
      	HRRM  	03,2M    
      	MOVNI 	03,1
      	MOVEM 	03,%TEMP.+1
      	JSA   	16,LOOP  
      	ARG   	00,%TEMP.
2M    	ARG   	00,2M    
      	ARG   	00,%TEMP.+1
      	ARG   	00,Y     
      	ARG   	00,CONST.
      	ARG   	00,ST    

				17200	      GO TO 182
      	JRST  	182P  

				17300	

				17400	2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
2851P 	MOVEI 	02,1
      	ADD   	02,Y     
      	MOVE  	04,X22   
      	MOVE  	03,WDS   (4)
      	ADD   	03,2
      	MOVEM 	03,%TEMP.
      	MOVE  	04,X     
      	ADD   	02,WDS   -1(4)
      	MOVEM 	02,%TEMP.+1
      	MOVN  	04,Y     
      	MOVEM 	04,%TEMP.+2
      	JSA   	16,LOOP  
      	ARG   	00,%TEMP.
      	ARG   	00,%TEMP.+1
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 22


      	ARG   	00,CONST.+1
      	ARG   	00,CONST.
      	ARG   	00,%TEMP.+2
      	ARG   	00,ST    

				17500	      JX=WDS(X)+1
      	MOVEI 	02,1
      	MOVE  	03,X     
      	ADD   	02,WDS   -1(3)
      	MOVEM 	02,JX    

				17600	

				17700	182   CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
182P  	MOVEI 	02,1
      	MOVE  	03,X22   
      	ADD   	02,WDS   -1(3)
      	MOVEM 	02,%TEMP.
      	JSA   	16,LOOP  
      	ARG   	00,CONST.+1
      	ARG   	00,J     
      	ARG   	00,CONST.+1
      	ARG   	00,%TEMP.
      	ARG   	00,JX    
      	ARG   	00,ST    

				17800	      DO 183 K=X22+1,X
      	MOVEI 	02,1
      	ADD   	02,X22   
      	MOVE  	15,2
3M    	MOVEM 	15,K     
4M    	BLOCK	0

				17900	      PWDS(K)=PWDS(K)+Z
      	JSA   	16,FLOAT 
      	ARG   	00,Z     
      	FADRM 	00,PWDS  -1(15)

				18000	183   WDS(K)=WDS(K)+Y
183P  	MOVE  	02,Y     
      	ADDM  	02,WDS   -1(15)
      	CAMGE 	15,X     
      	AOJA  	15,4M    

				18100	      ST(2)=WDS(X)
      	MOVE  	03,X     
      	MOVE  	02,WDS   -1(3)
      	MOVEM 	02,ST    +1

				18200	      X22=0
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 23


      	SETZM 	X22   

				18400	      END

      	JRST  	5M    
JUGGL%	ARG   	00,0
      	MOVEM 	15,TEMP. 
      	MOVEM 	16,TEMP. +1
      	JRST  	1M    
5M    	MOVE  	15,TEMP. 
      	MOVE  	16,TEMP. +1
      	JRA   	16,0(16)


CONSTANTS

0	000000000000	1	000000000001	

COMMON

X22   	/DL    /+0	SAVER 	/DL    /+1	NAME  	/DL    /+2	RN    	/XRN   /+0	PWDS  	/PTR   /+0
ITEM  	/PTR   /+372	L     	/PTR   /+373	I     	/PTR   /+374	IX    	/PTR   /+375	ST    	/DPY   /+0
WDS   	/DPY   /+7640	MEDIT 	/DPY   /+10232	IGO   	/DPY   /+10233	

SUBPROGRAMS

IFIX  	LOOP  	FLOAT 	

SCALARS

JUGGLE	253		ITEM  	372		JX    	254		MEDIT 	10232		JY    	255	
IX    	375		Z     	256		I     	374		J     	257		X     	260	
X22   	0		Y     	261		K     	262		SAVER 	1		NAME  	2	
L     	373		IGO   	10233		

ARRAYS

RN    	0		PWDS  	0		ST    	0		WDS   	7640		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 24


				18500	

				18600	


				18700	      SUBROUTINE LOOP(I,J,K,L,M,N)
1M    	BLOCK	0

				18800	      DIMENSION N(1)

				18900	      DO 1 NN=I,J,K
      	MOVE  	15,I     
2M    	MOVEM 	15,NN    
3M    	BLOCK	0

				19000	1     N(NN+L)=N(NN+M)
1P    	MOVE  	02,15
      	ADD   	02,L     
      	MOVE  	03,N     
      	ADD   	03,2
      	MOVE  	05,15
      	ADD   	05,M     
      	MOVE  	06,N     
      	ADD   	06,5
      	MOVE  	04,777777(6)
      	MOVEM 	04,777777(3)
      	ADD   	15,K     
      	MOVE  	03,J     
      	SUBM  	15,3
      	SKIPGE	00,K     
      	MOVN  	03,3
      	JUMPLE	03,3M    

				19200	      END

      	JRST  	4M    
LOOP% 	ARG   	00,0
      	MOVEM 	15,TEMP. 
      	MOVEM 	16,TEMP. +1
      	MOVEI 	00,TEMP. +2
      	PUSH  	00,@0(16)
      	PUSH  	00,@1(16)
      	PUSH  	00,@2(16)
      	PUSH  	00,@3(16)
      	PUSH  	00,@4(16)
      	PUSH  	00,5(16)
      	JRST  	1M    
4M    	MOVE  	15,TEMP. 
      	MOVE  	16,TEMP. +1
      	HRROI 	00,TEMP. +10
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 25


      	SUBI  	00,2
      	POP   	00,@3(16)
      	JRA   	16,6(16)



GLOBAL DUMMIES

I     	47		J     	50		K     	51		L     	52		M     	53	
N     	54		

SCALARS

LOOP  	55		NN    	56		I     	47		J     	50		K     	51	
L     	52		M     	53		

ARRAYS

N     	54		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 26


				19300	

				19400	


				19500	      SUBROUTINE PLTSRT
1M    	BLOCK	0

				19600	C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING.

				19700	      IMPLICIT INTEGER(S-Z)

				19800	      COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX

				19940	      COMMON/DPY/P(4000),WDS(250),MEDIT,IGO

				20000	      DO 4 K=1,ITEM
      	MOVEI 	15,1
2M    	MOVEM 	15,K     
3M    	BLOCK	0

				20100	      L=PWDS(K)
      	MOVE  	02,PWDS  -1(15)
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,L     

				20200	4     P(K)=RN(L+2)+1000*RN(L+3)
4P    	MOVSI 	02,212764
      	MOVE  	03,L     
      	FMPR  	02,RN    +2(3)
      	FADR  	02,RN    +1(3)
      	MOVEM 	02,P     -1(15)
      	CAMGE 	15,ITEM  
      	AOJA  	15,3M    

				20300	      Y=I
      	MOVE  	02,I     
      	MOVEM 	02,Y     

				20400	      W=(I-1)*2
      	MOVNI 	02,1
      	ADD   	02,I     
      	ASH   	02,1
      	MOVEM 	02,W     

				20500	2     A=P(1)
2P    	MOVE  	02,P     
      	MOVEM 	02,A     

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 27


				20600	      L=1
      	MOVEI 	02,1
      	MOVEM 	02,L     

				20700	      DO 1 K=1,ITEM
      	MOVEI 	15,1
4M    	MOVEM 	15,K     
5M    	BLOCK	0

				20800	      IF(A.LE.P(K))GO TO 1
      	MOVE  	02,A     
      	CAMG  	02,P     -1(15)
      	JRST  	1P    

				20900	      A=P(K)
      	MOVE  	02,P     -1(15)
      	MOVEM 	02,A     

				21000	      L=K
      	MOVEM 	15,L     

				21100	1     CONTINUE
1P    	CAMGE 	15,ITEM  
      	AOJA  	15,4M    

				21200	      IF(A.EQ.10000.)RETURN
      	MOVE  	02,CONST.
      	CAME  	02,A     
      	JRST  	6M    
      	JRST  	7M    
6M    	BLOCK	0

				21300	C  ALL ITEMS HAVE NOW BEEN SHUFFLED

				21400	      V=PWDS(L)
      	MOVE  	03,L     
      	MOVE  	02,PWDS  -1(3)
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,V     

				21500	      P(L)=10000
      	MOVE  	02,L     
      	MOVE  	03,CONST.
      	MOVEM 	03,P     -1(2)

				21600	      L=RN(V)+2
      	MOVSI 	02,202400
      	MOVE  	03,V     
      	FADR  	02,RN    -1(3)
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 28


      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,L     

				21700	      CALL LOOP(0,L,1,Y,V,RN)
      	JSA   	16,LOOP  
      	ARG   	00,CONST.+1
      	ARG   	00,L     
      	ARG   	00,CONST.+2
      	ARG   	00,Y     
      	ARG   	00,V     
      	ARG   	02,RN    

				21800	      Y=Y+L+1
      	MOVEI 	02,1
      	ADD   	02,L     
      	ADDM  	02,Y     

				21900	      GO TO 2
      	JRST  	2P    

				22000	      END

      	JRST  	7M    
PLTSR%	ARG   	00,0
      	MOVEM 	15,TEMP. 
      	MOVEM 	16,TEMP. +1
      	JRST  	1M    
7M    	MOVE  	15,TEMP. 
      	MOVE  	16,TEMP. +1
      	JRA   	16,0(16)


CONSTANTS

0	216470400000	1	000000000000	2	000000000001	

COMMON

RN    	/XRN   /+0	PWDS  	/PTR   /+0	ITEM  	/PTR   /+372	L     	/PTR   /+373	I     	/PTR   /+374
IX    	/PTR   /+375	P     	/DPY   /+0	WDS   	/DPY   /+7640	MEDIT 	/DPY   /+10232	IGO   	/DPY   /+10233

SUBPROGRAMS

IFIX  	LOOP  	

SCALARS

PLTSRT	114		K     	115		ITEM  	372		L     	373		Y     	116	
I     	374		W     	117		A     	120		V     	121		IX    	375	
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 29


MEDIT 	10232		IGO   	10233		

ARRAYS

RN    	0		PWDS  	0		P     	0		WDS   	7640		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 30


				22100	

				22200	

				22300	


				22400	      SUBROUTINE BOX(I,R,STFF)
1M    	BLOCK	0

				22500	      COMMON /SIZ/RSZ,JCEN,KCEN /XRN/RN(4000) /STF/RSTFAC(8),RSTJC

				22800	      COMMON/SCM/V(78),ISCR,LCNT,RSTF,N(400),LIST(200),REND

				22900	      DIMENSION STFF(1)

				23000	      IF(I)GO TO 4
      	MOVE  	02,I     
      	JUMPL 	02,4P    

				23100	      K=R+4
      	MOVSI 	02,203400
      	FADR  	02,R     
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,K     

				23200	      K=(STFF(K)+AMOD(RN(I+4),100.0)*7.*RSTFAC(K)
				23300	     1 -60.0)*RSZ-KCEN
      	MOVN  	02,CONST.
      	MOVE  	03,K     
      	ADD   	03,STFF  
      	FADR  	02,777777(3)
      	MOVE  	04,I     
      	MOVEI 	03,RN    +3(4)
      	HRRM  	03,2M    
      	JSA   	16,AMOD  
2M    	ARG   	02,2M    
      	ARG   	02,CONST.+1
      	FMPRI 	00,203700
      	MOVE  	03,K     
      	FMPR  	00,RSTFAC-1(3)
      	FADR  	00,2
      	FMPR  	00,RSZ   
      	MOVEM 	00,%TEMP.
      	JSA   	16,FLOAT 
      	ARG   	00,KCEN  
      	FSBR  	00,%TEMP.
      	MOVNM 	00,%TEMP.+1
      	JSA   	16,IFIX  
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 31


      	ARG   	00,%TEMP.+1
      	MOVEM 	00,K     

				23400	C  AMOD IS FOR MINI NOTES AND CLEFS

				23500	      L=RHORZ(RN(I+2))*RSZ-JCEN-25
      	MOVNI 	02,31
      	SUB   	02,JCEN  
      	JSA   	16,FLOAT 
      	ARG   	00,2
      	MOVEM 	00,%TEMP.
      	MOVE  	04,I     
      	MOVEI 	03,RN    +1(4)
      	HRRM  	03,3M    
      	JSA   	16,RHORZ 
3M    	ARG   	02,3M    
      	FMPR  	00,RSZ   
      	FADR  	00,%TEMP.
      	MOVEM 	00,%TEMP.+1
      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.+1
      	MOVEM 	00,L     

				23600	      IF(IABS(L).GT.550)L=512
      	JSA   	16,IABS  
      	ARG   	00,L     
      	CAIG  	00,1046
      	JRST  	4M    
      	MOVEI 	02,1000
      	MOVEM 	02,L     
4M    	BLOCK	0

				23700	      IF(IABS(K).GT.550)K=512
      	JSA   	16,IABS  
      	ARG   	00,K     
      	CAIG  	00,1046
      	JRST  	5M    
      	MOVEI 	02,1000
      	MOVEM 	02,K     
5M    	BLOCK	0

				23800	1     CALL ALINE(L,K,L+50,K)
1P    	MOVEI 	02,62
      	ADD   	02,L     
      	MOVEM 	02,%TEMP.
      	JSA   	16,ALINE 
      	ARG   	00,L     
      	ARG   	00,K     
      	ARG   	00,%TEMP.
      	ARG   	00,K     
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 32



				23900	      CALL RVECT(0,100)
      	JSA   	16,RVECT 
      	ARG   	00,CONST.+2
      	ARG   	00,CONST.+3

				24000	      CALL RVECT(-50,0)
      	MOVNI 	02,62
      	MOVEM 	02,%TEMP.
      	JSA   	16,RVECT 
      	ARG   	00,%TEMP.
      	ARG   	00,CONST.+2

				24100	      CALL RVECT(0,-100)
      	MOVNI 	02,144
      	MOVEM 	02,%TEMP.
      	JSA   	16,RVECT 
      	ARG   	00,CONST.+2
      	ARG   	00,%TEMP.

				24200	      L=L+25
      	MOVEI 	02,31
      	ADDM  	02,L     

				24300	2     CALL ALINE(L,K-25,L,K+125)
2P    	MOVNI 	02,31
      	ADD   	02,K     
      	MOVEM 	02,%TEMP.
      	MOVEI 	03,175
      	ADD   	03,K     
      	MOVEM 	03,%TEMP.+1
      	JSA   	16,ALINE 
      	ARG   	00,L     
      	ARG   	00,%TEMP.
      	ARG   	00,L     
      	ARG   	00,%TEMP.+1

				24450	3     CALL DPYOUT(1)
3P    	JSA   	16,DPYOUT
      	ARG   	00,CONST.+4

				24500	      RETURN
      	JRST  	6M    

				24600	4     IF(I.LT.-1)GO TO 5
4P    	MOVNI 	02,1
      	CAMLE 	02,I     
      	JRST  	5P    

				24700	      CALL DPYSET(3,N,100)
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 33


      	JSA   	16,DPYSET
      	ARG   	00,CONST.+5
      	ARG   	00,N     
      	ARG   	00,CONST.+3

				24800	      CALL DPYBRT(3)
      	JSA   	16,DPYBRT
      	ARG   	00,CONST.+5

				24900	5     L=RHORZ(R)*RSZ-JCEN
5P    	JSA   	16,RHORZ 
      	ARG   	02,R     
      	FMPR  	00,RSZ   
      	MOVEM 	00,%TEMP.
      	JSA   	16,FLOAT 
      	ARG   	00,JCEN  
      	FSBR  	00,%TEMP.
      	MOVNM 	00,%TEMP.+1
      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.+1
      	MOVEM 	00,L     

				25000	      IF(IABS(L).GT.550)RETURN
      	JSA   	16,IABS  
      	ARG   	00,L     
      	CAIG  	00,1046
      	JRST  	7M    
      	JRST  	6M    
7M    	BLOCK	0

				25100	      CALL SETPOG(3)
      	JSA   	16,SETPOG
      	ARG   	00,CONST.+5

				25200	      CALL ALINE(L,-511,L,511)
      	MOVNI 	02,777
      	MOVEM 	02,%TEMP.
      	JSA   	16,ALINE 
      	ARG   	00,L     
      	ARG   	00,%TEMP.
      	ARG   	00,L     
      	ARG   	00,CONST.+6

				25300	      CALL DPYOUT(3)
      	JSA   	16,DPYOUT
      	ARG   	00,CONST.+5

				25400	      CALL SETPOG(1)
      	JSA   	16,SETPOG
      	ARG   	00,CONST.+4
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 34



				25600	      END

      	JRST  	6M    
BOX%  	ARG   	00,0
      	MOVEM 	15,TEMP. 
      	MOVEM 	16,TEMP. +1
      	MOVEI 	00,TEMP. +2
      	PUSH  	00,@0(16)
      	PUSH  	00,@1(16)
      	PUSH  	00,2(16)
      	JRST  	1M    
6M    	MOVE  	15,TEMP. 
      	MOVE  	16,TEMP. +1
      	HRROI 	00,TEMP. +5
      	SUBI  	00,1
      	POP   	00,@1(16)
      	JRA   	16,3(16)


CONSTANTS

0	206740000000	1	207620000000	2	000000000000	3	000000000144	4	000000000001
5	000000000003	6	000000000777	

GLOBAL DUMMIES

I     	236		R     	237		STFF  	240		

COMMON

RSZ   	/SIZ   /+0	JCEN  	/SIZ   /+1	KCEN  	/SIZ   /+2	RN    	/XRN   /+0	RSTFAC	/STF   /+0
RSTJC 	/STF   /+10	V     	/SCM   /+0	ISCR  	/SCM   /+116	LCNT  	/SCM   /+117	RSTF  	/SCM   /+120
N     	/SCM   /+121	LIST  	/SCM   /+741	REND  	/SCM   /+1251	

SUBPROGRAMS

IFIX  	AMOD  	FLOAT 	RHORZ 	IABS  	ALINE 	RVECT 	DPYOUT	DPYSET	DPYBRT	SETPOG	

SCALARS

BOX   	243		I     	236		K     	244		R     	237		RSZ   	0	
KCEN  	2		L     	245		JCEN  	1		RSTJC 	10		ISCR  	116	
LCNT  	117		RSTF  	120		REND  	1251		

ARRAYS

RN    	0		RSTFAC	0		V     	0		N     	121		LIST  	741	
STFF  	240		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 35


PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 36


				25700	


				25800	      SUBROUTINE LINES(A,B,L)
1M    	BLOCK	0

				25900	      COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP

				26000	      COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS

				26100	      COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)

				26200	      COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO

				26400	      EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000)),(RXGP,WDS(250))

				26500	      DATA BB/260.0/,CC/3.5/,DD/1.43/,MX/512/,XGP/1200.0/

				26600	C  SET XGP TO 1245.0 FOR MARGIN IN XEROX COPIES

				26700	22    GO TO 23
22P   	JRST  	23P   

				26800	C  CHANGE ABOVE TO 'JFCL' IN DDT TO USE NEXT ITEMS.

				26900	24    AA=CC-DD*ABS(A)/BB
24P   	JSA   	16,ABS   
      	ARG   	02,A     
      	FMPR  	00,DD    
      	FDVR  	00,BB    
      	FSBR  	00,CC    
      	MOVNM 	00,AA    

				27000	C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD

				27100	      B=B*AA
      	MOVE  	02,AA    
      	FMPRM 	02,B     

				27200	23    IF(IPLT)GO TO 2
23P   	MOVE  	02,IPLT  
      	JUMPL 	02,2P    

				27300	      M=A*RSZ
      	MOVE  	02,A     
      	FMPR  	02,RSZ   
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,M     

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 37


				27400	      N=B*RSZ
      	MOVE  	02,B     
      	FMPR  	02,RSZ   
      	JSA   	16,IFIX  
      	ARG   	00,2
      	MOVEM 	00,N     

				27500	      IF(RSZ.LE.0.8571)GO TO 3
      	MOVE  	02,CONST.
      	CAML  	02,RSZ   
      	JRST  	3P    

				27600	C NEXT FOR DISPLAY MAGNIFICATION

				27700	      M=M-JCEN
      	MOVN  	02,JCEN  
      	ADDM  	02,M     

				27800	      N=N-KCEN
      	MOVN  	02,KCEN  
      	ADDM  	02,N     

				27900	      IF(JA.NE.10)GO TO 5
      	MOVEI 	02,12
      	CAME  	02,JA    
      	JRST  	5P    

				28000	C NEXT INSURES DISPLAY OF STAFF LINES

				28100	      IF(M.GT.511)M=511
      	MOVEI 	02,777
      	CAML  	02,M     
      	JRST  	2M    
      	MOVEI 	02,777
      	MOVEM 	02,M     
2M    	BLOCK	0

				28200	      IF(M.LT.-511)M=-511
      	MOVNI 	02,777
      	CAMG  	02,M     
      	JRST  	3M    
      	MOVNI 	02,777
      	MOVEM 	02,M     
3M    	BLOCK	0

				28300	C THE ABOVE LINES ADDED 2 APR.72, LABEL 3 ADDED TO NEXT LINE

				28400	5     IF(IABS(M).LT.512.AND.IABS(N).LT.512)GO TO 4
5P    	JSA   	16,IABS  
      	ARG   	00,N     
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 38


      	CAIL  	00,1000
      	TDZA  	00,0
      	SETO  	00,0
      	MOVEM 	00,%TEMP.
      	JSA   	16,IABS  
      	ARG   	00,M     
      	CAIL  	00,1000
      	TDZA  	00,0
      	SETO  	00,0
      	AND   	00,%TEMP.
      	JUMPL 	00,4P    

				28500	C  NOW DRAWS INVISIBLE VECT. IF IT GOES OFF THE SCREEN.

				28600	      KZ=-1
      	SETOM 	KZ    

				28700	      RETURN
      	JRST  	4M    

				28800	4     IF(KZ.EQ.0)GO TO 6
4P    	MOVE  	02,KZ    
      	JUMPE 	02,6P    

				28900	      KZ=0
      	SETZM 	KZ    

				29000	      GO TO 1
      	JRST  	1P    

				29100	3     K=B
3P    	JSA   	16,IFIX  
      	ARG   	00,B     
      	MOVEM 	00,K     

				29200	      IF(K.GT.ITOP)ITOP=B
      	MOVE  	02,K     
      	CAMG  	02,ITOP  
      	JRST  	5M    
      	JSA   	16,IFIX  
      	ARG   	00,B     
      	MOVEM 	00,ITOP  
5M    	BLOCK	0

				29300	      IF(K.LT.IBOT)IBOT=B
      	MOVE  	02,K     
      	CAML  	02,IBOT  
      	JRST  	6M    
      	JSA   	16,IFIX  
      	ARG   	00,B     
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 39


      	MOVEM 	00,IBOT  
6M    	BLOCK	0

				29400	6     IF(L.EQ.3)GO TO 1
6P    	MOVEI 	02,3
      	CAMN  	02,L     
      	JRST  	1P    

				29500	      CALL AVECT(M,N)
      	JSA   	16,AVECT 
      	ARG   	00,M     
      	ARG   	00,N     

				29600	      RETURN
      	JRST  	4M    

				29700	1     CALL AIVECT(M,N)
1P    	JSA   	16,AIVECT
      	ARG   	00,M     
      	ARG   	00,N     

				29800	      RETURN
      	JRST  	4M    

				29900	2     IF(IPLT.EQ.-2)RETURN
2P    	MOVNI 	02,2
      	CAME  	02,IPLT  
      	JRST  	7M    
      	JRST  	4M    
7M    	BLOCK	0

				30000	CC	AX=.5

				30100	CC	IF(A)AX=-AX

				30200	CC	BX=.5

				30300	C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)

				30400	CC	IF(B)BX=-BX

				30500	C  AX AND BX ARE FOR ROUND-OFF

				30600	      IF(IXRX.EQ.0)GO TO 9
      	MOVE  	02,IXRX  
      	JUMPE 	02,9P    

				30610	      M=ROFF(RXGP-B*RHT)
      	MOVE  	02,B     
      	FMPR  	02,RHT   
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 40


      	FSBR  	02,RXGP  
      	MOVNM 	02,%TEMP.
      	JSA   	16,ROFF  
      	ARG   	02,%TEMP.
      	MOVEM 	00,%TEMP.+1
      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.+1
      	MOVEM 	00,M     

				30620	      N=ROFF(XGP+A*DIS)
      	MOVE  	02,A     
      	FMPR  	02,DIS   
      	FADR  	02,XGP   
      	MOVEM 	02,%TEMP.
      	JSA   	16,ROFF  
      	ARG   	02,%TEMP.
      	MOVEM 	00,%TEMP.+1
      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.+1
      	MOVEM 	00,N     

				30700	CC	M=-B*RHT-BX+RXGP

				30800	CC	N=A*DIS+XGP+AX

				30900	      GO TO 8
      	JRST  	8P    

				31000	CC9	M=A*DIS+AX

				31100	CC	N=B*RHT+BX

				31110	9     M=ROFF(A*DIS)
9P    	MOVE  	02,A     
      	FMPR  	02,DIS   
      	MOVEM 	02,%TEMP.
      	JSA   	16,ROFF  
      	ARG   	02,%TEMP.
      	MOVEM 	00,%TEMP.+1
      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.+1
      	MOVEM 	00,M     

				31120	      N=ROFF(B*RHT)
      	MOVE  	02,B     
      	FMPR  	02,RHT   
      	MOVEM 	02,%TEMP.
      	JSA   	16,ROFF  
      	ARG   	02,%TEMP.
      	MOVEM 	00,%TEMP.+1
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 41


      	JSA   	16,IFIX  
      	ARG   	00,%TEMP.+1
      	MOVEM 	00,N     

				31200	8     CALL PLOT(M,N,L)
8P    	JSA   	16,PLOT  
      	ARG   	00,M     
      	ARG   	00,N     
      	ARG   	00,L     

				31400	      END

      	JRST  	4M    
LINES%	ARG   	00,0
      	MOVEM 	15,TEMP. 
      	MOVEM 	16,TEMP. +1
      	MOVEI 	00,TEMP. +2
      	PUSH  	00,@0(16)
      	PUSH  	00,@1(16)
      	PUSH  	00,@2(16)
      	JRST  	1M    
4M    	MOVE  	15,TEMP. 
      	MOVE  	16,TEMP. +1
      	HRROI 	00,TEMP. +5
      	POP   	00,@2(16)
      	POP   	00,@1(16)
      	POP   	00,@0(16)
      	JRA   	16,3(16)


CONSTANTS

0	200666653476	

GLOBAL DUMMIES

A     	233		B     	234		L     	235		

COMMON

RSZ   	/SIZ   /+0	JCEN  	/SIZ   /+1	KCEN  	/SIZ   /+2	IC    	/FL    /+0	NZ    	/FL    /+1
NX    	/FL    /+2	RZ    	/FL    /+3	XGP   	/FL    /+4	IXRX  	/DL    /+0	SAVER 	/DL    /+1
AA    	/DL    /+2	IPLT  	/PLTR  /+0	RHT   	/PLTR  /+1	DIS   	/PLTR  /+2	RJB   	/.COMM./+0
JA    	/.COMM./+1	CENTR 	/.COMM./+2	JB    	/.COMM./+3	RJQ   	/.COMM./+4	JQ    	/.COMM./+30
JJ    	/DPY   /+0	WDS   	/DPY   /+7640	MEDIT 	/DPY   /+10232	IGO   	/DPY   /+10233	ITOP  	/DPY   /+7636
IBOT  	/DPY   /+7637	RXGP  	/DPY   /+10231	

SUBPROGRAMS

ABS   	IFIX  	IABS  	AVECT 	AIVECT	ROFF  	PLOT  	
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 42



SCALARS

LINES 	240		BB    	241		CC    	242		DD    	243		MX    	244	
XGP   	4		AA    	2		A     	233		B     	234		IPLT  	0	
M     	245		RSZ   	0		N     	246		JCEN  	1		KCEN  	2	
JA    	1		KZ    	247		K     	250		ITOP  	7636		IBOT  	7637	
L     	235		IXRX  	0		RXGP  	10231		RHT   	1		DIS   	2	
IC    	0		NZ    	1		NX    	2		RZ    	3		SAVER 	1	
RJB   	0		CENTR 	2		JB    	3		MEDIT 	10232		IGO   	10233	

ARRAYS

RJQ   	4		JQ    	30		JJ    	0		WDS   	7640		

PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 43


				31540	


				31600	      SUBROUTINE RDRAW(I,S,XY,X,RJB,CENTR,RMINI)
1M    	BLOCK	0

				31700	C   TO X,Y INTO ONE WORD

				31800	      DIMENSION XY(1)

				31900	      DO 2 K=I,IFIX(S)
      	JSA   	16,IFIX  
      	ARG   	02,S     
      	MOVEM 	00,TEMP. 
      	MOVE  	15,I     
2M    	MOVEM 	15,K     
3M    	BLOCK	0

				32000	      L=2
      	MOVEI 	02,2
      	MOVEM 	02,L     

				32100	      Y=XY(K)
      	MOVE  	03,15
      	ADD   	03,XY    
      	MOVE  	02,777777(3)
      	MOVEM 	02,Y     

				32200	      IF(Y.LT.1000.)GO TO 3
      	MOVSI 	02,212764
      	CAMLE 	02,Y     
      	JRST  	3P    

				32300	      L=3
      	MOVEI 	02,3
      	MOVEM 	02,L     

				32400	      Y=Y-1000.
      	MOVN  	02,CONST.
      	FADRM 	02,Y     

				32500	C   >1000 = INVIS. LINE

				32600	3     M=Y
3P    	JSA   	16,IFIX  
      	ARG   	00,Y     
      	MOVEM 	00,M     

				32700	      Y=(Y-M)*1000.
      	JSA   	16,FLOAT 
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 44


      	ARG   	00,M     
      	FSBR  	00,Y     
      	FMPRI 	00,212764
      	MOVNM 	00,Y     

				32800	      IF(Y.GT.100.)Y=100-Y
      	MOVSI 	02,207620
      	CAML  	02,Y     
      	JRST  	4M    
      	MOVSI 	02,570160
      	FADRM 	02,Y     
      	MOVNS 	00,Y     
4M    	BLOCK	0

				32900	C   Y NUMBERS .GT.100 ARE NEG.

				33000	      B=Y*X+CENTR
      	MOVE  	02,Y     
      	FMPR  	02,X     
      	FADR  	02,CENTR 
      	MOVEM 	02,B     

				33100	      IF(M.GT.60)M=100-M
      	MOVEI 	02,74
      	CAML  	02,M     
      	JRST  	5M    
      	MOVNI 	02,144
      	ADDM  	02,M     
      	MOVNS 	00,M     
5M    	BLOCK	0

				33200	      A=M*RMINI+RJB
      	JSA   	16,FLOAT 
      	ARG   	00,M     
      	FMPR  	00,RMINI 
      	FADR  	00,RJB   
      	MOVEM 	00,A     

				33300	2     CALL LINES(A,B,L)
2P    	JSA   	16,LINES 
      	ARG   	02,A     
      	ARG   	02,B     
      	ARG   	00,L     
      	MOVE  	15,K     
      	CAMGE 	15,TEMP. 
      	AOJA  	15,2M    

				33500	      END

      	JRST  	6M    
PLTSRT.F4	F40	V25	6-OCT-73	8:38	PAGE 45


RDRAW%	ARG   	00,0
      	MOVEM 	15,TEMP. +1
      	MOVEM 	16,TEMP. +2
      	MOVEI 	00,TEMP. +3
      	PUSH  	00,@0(16)
      	PUSH  	00,@1(16)
      	PUSH  	00,2(16)
      	PUSH  	00,@3(16)
      	PUSH  	00,@4(16)
      	PUSH  	00,@5(16)
      	PUSH  	00,@6(16)
      	JRST  	1M    
6M    	MOVE  	15,TEMP. +1
      	MOVE  	16,TEMP. +2
      	HRROI 	00,TEMP. +12
      	SUBI  	00,5
      	POP   	00,@1(16)
      	JRA   	16,7(16)


CONSTANTS

0	212764000000	

GLOBAL DUMMIES

I     	116		S     	117		XY    	120		X     	121		RJB   	122	
CENTR 	123		RMINI 	124		

SUBPROGRAMS

IFIX  	FLOAT 	LINES 	

SCALARS

RDRAW 	125		K     	126		I     	116		S     	117		L     	127	
Y     	130		M     	131		B     	132		X     	121		CENTR 	123	
A     	133		RMINI 	124		RJB   	122		

ARRAYS

XY    	120